home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Design
/
WB Collection.iso
/
workbench werkzeuge
/
uhren & terminkalender
/
organizer
/
kalender
/
txt
/
commands.mod
< prev
next >
Wrap
Text File
|
1996-04-07
|
3KB
|
133 lines
IMPLEMENTATION MODULE Commands; (* Copyright 1993 by Kai Hofmann *)
(*$ StackChk := FALSE *)
(*$ RangeChk := FALSE *)
(*$ OverflowChk := FALSE *)
(*$ NilChk := FALSE *)
(*$ CaseChk := FALSE *)
(*$ ReturnChk := FALSE *)
(*$ LargeVars := FALSE *)
(*$ EntryClear := TRUE *)
(*$ Volatile := TRUE *)
(*$ StackParms := TRUE *)
(*$ CStrings := TRUE *)
FROM SYSTEM IMPORT ADR,ADDRESS;
FROM Arts IMPORT wbStarted;
FROM Arguments IMPORT NumArgs, GetArg, quoted;
FROM String IMPORT Copy,ComparePart,Length;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM IconL IMPORT GetDiskObject,FreeDiskObject,FindToolType,
MatchToolValue;
FROM WorkbenchD IMPORT DiskObject,DiskObjectPtr,WBArg,WBArgPtr;
VAR
num : INTEGER;
dptr : DiskObjectPtr;
len : INTEGER;
name : ARRAY [0..60] OF CHAR;
(* -------------------- Interne Prozeduren -------------------- *)
PROCEDURE CheckOpt (option : string) : INTEGER;
VAR
i : INTEGER;
len : INTEGER;
arg : string;
BEGIN
IF wbStarted THEN
IF FindToolType(dptr^.toolTypes,ADR(option)) # NIL THEN
RETURN(1);
ELSE
RETURN(-1);
END;
ELSE
i := 0;
WHILE i < num DO
INC(i);
GetArg(i,arg,len);
IF Length(option) > len THEN
len := Length(option);
END;
IF ComparePart(option,0,len,arg,FALSE) = 0 THEN
RETURN(i);
END;
END;
RETURN(-1);
END;
END CheckOpt;
(* -------------------- Externe Prozeduren -------------------- *)
PROCEDURE CheckOption (option : string) : BOOLEAN;
BEGIN
RETURN(CheckOpt(option)>0);
END CheckOption;
PROCEDURE GetOptionParam (option : string; VAR quotes : BOOLEAN) : strptr;
VAR
i : INTEGER;
len : INTEGER;
arg : string;
ptr : strptr;
BEGIN
IF wbStarted THEN
quotes := TRUE;
ptr := FindToolType(dptr^.toolTypes,ADR(option));
RETURN(ptr);
ELSE
i := CheckOpt(option);
INC(i);
IF i <= num THEN
GetArg(i,arg,len);
quotes := quoted;
ALLOCATE(ptr,SIZE(string));
Copy(ptr^,arg);
RETURN(ptr);
ELSE
RETURN(NIL);
END;
END;
END GetOptionParam;
PROCEDURE Killstr (param : strptr);
BEGIN
IF (param # NIL) AND (~wbStarted) THEN
DEALLOCATE(param,SIZE(string));
END;
END Killstr;
PROCEDURE AnzArg() : INTEGER;
BEGIN
RETURN(num);
END AnzArg;
BEGIN
IF wbStarted THEN
GetArg(0,name,len);
dptr := GetDiskObject(ADR(name));
num := 1;
ELSE
num := NumArgs();
END;
CLOSE
IF wbStarted THEN
FreeDiskObject(dptr);
END;
END Commands.